home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / TPRCDR10 / MCOPY.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-26  |  3KB  |  98 lines
  1. { ╔═══════════╤════════════════════════════════════════════════╗
  2.   ║ Programmer│ Tony Papadimitriou                             ║
  3.   ║ Program   │ MCOPY                                          ║
  4.   ║ Uses      │ Dos, TPUtils, TPRecDir                         ║
  5.   ║ Includes  │ Nothing                                        ║
  6.   ║ Links     │ Nothing                                        ║
  7.   ║ Created   │ Sunday, December 19, 1993  2:08 am             ║
  8.   ║ Updated   │ Monday, December 20, 1993  9:57 pm             ║
  9.   ║ Language  │ (MSDOS) Turbo Pascal 6.0                       ║
  10.   ║ Purpose   │ Show off TPRecDir unit                         ║
  11.   ╟───────────┴┬──────── Version History ──────────────────────╢
  12.   ║ 1.00       │Original                                       ║
  13.   ╚════════════╧═══════════════════════════════════════════════╝ }
  14. uses
  15.   Dos,
  16.   TPUtils,
  17.   TPRecDir;
  18.  
  19. const
  20.   progName = 'MCOPY';
  21.   version  = '1.00';
  22.  
  23. procedure Copyright;
  24. begin
  25.   Writeln(stderr);
  26.   Writeln(stderr,progName+' ver. ' + version + ' ■ Copyright (c) 1993-94 by Tony G. Papadimitriou *FREEWARE*');
  27.   Writeln(stderr);
  28. end; { Copyright }
  29.  
  30. var
  31.   totalMatches : Longint;
  32.   copied       : Longint;     { files actually copied }
  33.   failed       : Longint;     { files that failed to copy }
  34.   dest         : PathStr;
  35.  
  36. { --- this is the user routine whose address you must supply to ForEachFileIn }
  37. function List(rec: SearchRec): Boolean; far;
  38. var
  39.   temp: String;
  40. begin
  41.   List := True;
  42.   ShowProgressHere;
  43.   if not AttributeMatches(rec.attr,Directory) then
  44.   begin
  45.     Inc(totalMatches);
  46.     BlankLine;
  47.     { --- prepare destination filename }
  48.     if (Length(dest) > 0) and (dest[ Length(dest) ] = '\') then
  49.       Delete(dest,Length(dest),1);
  50.     temp := FExpand(dest + '\' + rec.name);
  51.     { --- now, copy it }
  52.     Write('Copying ',Left(FExpand(rec.name)+' to '+temp,60,'.'),'  ');
  53.     if not CopyFile(FExpand(rec.name),temp,No) then
  54.     begin
  55.       Writeln('*FAILED*');
  56.       Inc(failed);
  57.     end
  58.     else
  59.     begin
  60.       Writeln('√');
  61.       Inc(copied);
  62.     end;
  63.     Write(stderr,'Working  ');
  64.   end;
  65. end; { List }
  66.  
  67. var
  68.   path  : PathStr;
  69.   mask  : String;
  70. begin
  71.   Copyright;
  72.   if ParamCount = 0 then
  73.   begin
  74.     Writeln(stderr,'Usage: MCOPY [<path>\]<mask>[;<mask>] [<destination path>]');
  75.     Writeln(stderr);
  76.     Writeln(stderr,'       Press ESC during search to interrupt prematurely.');
  77.     Halt;
  78.   end; { if }
  79.   totalMatches := 0;
  80.   copied       := 0;
  81.   failed       := 0;
  82.   path := ParamStr(1);
  83.   mask := GetMask(path);
  84.   path := GetPath(path);
  85.   dest := ParamStr(2);
  86.   if dest = '' then GetDir(0,dest);
  87.   {$V-} LeftSlashes(dest); {$V+}
  88.   dest := FExpand(dest);
  89.   if path[ 1 ] = dest[ 1 ] then Abort(NIL,'Source and destination drives are the same');
  90.   Write(stderr,'Working  ');
  91.   ForEachFileIn(path,mask,AnyFile,True,True,@List);
  92.   BlankLine;
  93.   if errorsFound then Writeln(stderr,'Errors during processing!');
  94.   Writeln(stderr,totalMatches,' match',OneManyStr(totalMatches,'','es'),' found!');
  95.   Writeln(stderr,copied,' file',OneManyStr(copied,'','s'),' copied!');
  96.   Writeln(stderr,failed,' file',OneManyStr(failed,'','s'),' failed to copy!');
  97. end.
  98.